﻿Imports System.Windows.Forms
Imports System.Net.Sockets
Imports System.Text
Imports System.Net.Mail
Imports System.Management
Imports System.Xml
Imports System.Drawing

Module modFuncoes
    Public pDados() As Byte = {0}
    Public pCodForm As Integer = 0, pDir As String = "", pSql As String = ""
    Public pDataVer As String = Application.ProductVersion.Substring(6, 2) & "/" & Application.ProductVersion.Substring(3, 2) & "/" & "20" & Application.ProductVersion.Substring(0, 2)
    Public Function pDataC() As String
        Return "Em : " & pDataVer
    End Function
    Public Const pMsgEmpresa = "InterfaceNet"
    Public pTipoFilial As eTP = eTP.eT

    Public Sub FormataGrid(ByRef parGrid As DataGridView, Optional ByVal parMostraColuna As Boolean = False, Optional ByVal parZebrado As Boolean = True)
        With parGrid
            .AllowUserToAddRows = False
            .AllowUserToDeleteRows = False
            .AllowUserToResizeRows = False
            .AllowUserToResizeColumns = True
            .AllowUserToOrderColumns = True
            .MultiSelect = False
            .SelectionMode = DataGridViewSelectionMode.FullRowSelect
            If parZebrado Then .AlternatingRowsDefaultCellStyle.BackColor = Color.Ivory
            .RowHeadersVisible = parMostraColuna
            .BackgroundColor = Color.White
        End With
    End Sub
    Public Enum TempFormat
        Fahrenheit
        Celsius
        Kelvin
        Raw
    End Enum
    Public pNaoPula As Boolean, fErroTemperatura As Boolean = False, pErroLog As Boolean
    Private Declare Auto Function GetVolumeInformation Lib "kernel32.dll" ( _
         ByVal RootPathName As String, _
         ByVal VolumeNameBuffer As System.Text.StringBuilder, _
         ByVal VolumeNameSize As UInt32, _
         ByRef VolumeSerialNumber As UInt32, _
         ByRef MaximumComponentLength As UInt32, _
         ByRef FileSystemFlags As UInt32, _
         ByVal FileSystemNameBuffer As System.Text.StringBuilder, _
         ByVal FileSystemNameSize As UInt32) As UInt32
    Enum enuBotao
        Sair = 0
        Cancelar = 1
        Salvar = 2
        Consultar = 3
        Alterar = 4
        Incluir = 5
        Pesquisar = 6
        Visualizar = 7
    End Enum
    Enum eTP
        eD = 0
        eH = 1
        eDH = 2
        eDHMYSQL = 3
        eT = 4
        eN = 5
        eLike = 6
        eLikeI = 7
        eLikeF = 8
        eAspaDup = 9
        eD_yyyymmdd = 10
    End Enum
    Enum eDP
        eDN = 0
        eV = 1
        eF = 2
    End Enum
    Enum eAP
        eAN = 0
        eA = 1
        eW = 2
        eO = 3
        eBET = 4
    End Enum
    Public Function Cripto(ByVal texto As String, ByVal Tipo As Boolean)
        Dim temp As String, Con As String, L As Long, StrV As Long
        Con = ""
        For L = 1 To Len(texto)
            temp = ""
            temp = Mid(texto, L, 1)
            StrV = Asc(temp)
            If StrV = 10 Then
                Cripto = Con
                Exit Function
            End If
            If Tipo = True Then
                If StrV = 255 Then
                    StrV = 1
                Else
                    StrV = StrV + L
                End If
            Else
                If StrV = 1 Then
                    StrV = 255
                Else
                    StrV = StrV - L
                End If
            End If
            Con = Con + Chr(StrV)
        Next L
        Cripto = Con$
    End Function
    Function Criptografar(ByVal parTexto As String, Optional ByVal parNovo As Boolean = False) As String
        Dim temp As String = "", tempA As String, rand As String, rad As String, crntASC As String
        Dim i As Integer
100:
        Randomize()
        rand = Right(Rnd, 3)
        rad = Left(rand, 1)
        If Left(rand, 1) = "-" Then
            GoTo 100
        End If
        For i = 1 To Len(parTexto)
            crntASC = Asc(Mid(parTexto, i, 1))
            tempA = ((crntASC) Xor (rand + i + rad)) + (i + rad)
            If Len(tempA) = 4 Then
                temp = temp & tempA
            ElseIf Len(tempA) = 3 Then
                temp = temp & "0" & tempA
            ElseIf Len(tempA) = 2 Then
                temp = temp & "00" & tempA
            ElseIf Len(tempA) = 1 Then
                temp = temp & "000" & tempA
            End If
        Next i
        If parNovo Then
            i = Len(temp) / 2
            temp = temp.Substring(0, i) & rand & temp.Substring(i)
        Else
            temp = rand & temp
        End If

        Criptografar = temp
    End Function
    Public Function Descriptografar(ByVal parTexto As String, Optional ByVal parNovo As Boolean = False) As String
        Try
            Dim sTemp As String
            Dim sTemp1 As String
            Dim sTemp2 As String = ""
            Dim sCont1 As Integer
            Dim sCont2 As Integer
            Descriptografar = ""
            parTexto = Trim(parTexto)
            If parTexto.Length > 3 Then
                If parNovo Then
                    sCont1 = (Len(parTexto) - 3) / 2
                    sTemp = parTexto.Substring(sCont1, 3)
                    parTexto = parTexto.Substring(0, sCont1) & parTexto.Substring(sCont1 + 3)
                Else
                    sTemp = Left(parTexto, 3)
                    parTexto = parTexto.Substring(3)
                End If
                For sCont1 = 1 To Len(parTexto) Step 4
                    sCont2 = sCont2 + 1
                    sTemp1 = Mid(parTexto, sCont1, 4)
                    sTemp1 = ((sTemp1 - (sCont2 + Left(sTemp, 1))) Xor (sTemp + sCont2 + Left(sTemp, 1)))
                    sTemp2 = sTemp2 & Chr(sTemp1)
                Next sCont1
            End If
            Return sTemp2
        Catch ex As Exception
            GravaErro(Err, ex)
            Return ""
        End Try
    End Function
    Public Sub BackupLog()
        If Dir(pDir & "AUDIT\PDVLOG-" & Format(DateAdd(DateInterval.Month, -1, Now.Date), "MM-yy") & ".TXT") = "" And Dir(pDir & "PDVLOG.TXT") <> "" Then
            CopiaArquivo(pDir & "PDVLOG.TXT", pDir & "AUDIT\PDVLOG-" & Format(DateAdd(DateInterval.Month, -1, Now.Date), "MM-yy") & ".TXT", True)
        End If
    End Sub
    Public Function CopiaArquivo(ByVal parOrigem As String, ByVal parDestino As String, Optional ByVal parApagaOrigem As Boolean = True) As Boolean
        Try
            ApagaArquivo(parDestino)
            IO.File.Copy(parOrigem, parDestino)
            If parApagaOrigem Then ApagaArquivo(parOrigem)
            Return True
        Catch ex As Exception
            GravaErro(Err, ex)
            Return False
        End Try
    End Function
    Private Function AlimentaElemento(ByVal parDoc As XmlDocument, ByVal parNome As String, ByVal parValor As String) As XmlNode
        Dim sElemento As XmlElement
        sElemento = parDoc.CreateElement(parNome)
        sElemento.InnerText = parValor
        Return sElemento
    End Function
    Public Function HoraAtual() As String
        Return Now.Hour.ToString.PadLeft(2, "0") & ":" & Now.Minute.ToString.PadLeft(2, "0") & ":" & Now.Second.ToString.PadLeft(2, "0")
    End Function
    Public Function TipoBanco() As String
        If pClsPDVINT.TipoBanco = 1 Then
            Return " (NOLOCK) "
        Else
            Return ""
        End If
    End Function
    Public Sub GravaErro(Optional ByVal parErr As ErrObject = Nothing, Optional ByVal parEx As Exception = Nothing, Optional ByVal parSQL As String = "", Optional ByVal parExibeMsgErro As Boolean = True, Optional ByVal parOutrasMsg As String = "", Optional ByVal parGravaLog As Boolean = True)
        Dim sTexto As String
        Dim sArq As String = pDir & "ERROS\LOGERRO" & Format(Now.Date, "yyMMdd") & Now.Hour.ToString.PadLeft(2, "0") & Now.Minute.ToString.PadLeft(2, "0") & ".TXT"
        sTexto = "|Sistema|" & pTipoSys & "|" & Trim(pDataC) & "|Hora|" & HoraAtual() & "|" & pClsUsuario.Matricula & "|Formulario|" & Format(pCodForm, "00") & "|" & "|"
        If Not parEx Is Nothing Then
            sTexto = sTexto & "Erro|" & parEx.Message & "|" & parEx.Source & "|" & parSQL & "|" & parOutrasMsg & "|" & "|Err|" & "|" & Environment.MachineName & "|"
            If Not parErr Is Nothing AndAlso parErr.Erl > 0 Then sTexto = sTexto & "Linha:" & Err.Erl & "|"
        ElseIf Not parErr Is Nothing Then
            sTexto = sTexto & "Erro|" & parErr.Description & "|" & "" & "|" & parSQL & "|" & parOutrasMsg & "|" & "|Err|" & parErr.Number & "|" & Environment.MachineName & "|"
            If Err.Erl > 0 Then sTexto = sTexto & "Linha:" & Err.Erl & "|"
        Else
            sTexto = sTexto & "Erro|||" & parSQL & "|" & parOutrasMsg & "|" & "|Err||" & Environment.MachineName & "|"
        End If
        VerificaPasta(sArq)
        If parGravaLog Then
            IO.File.AppendAllText(sArq, sTexto & vbCrLf)
        End If
        'If Not pClsPDVINT.Sede Then
        '   Dim sClsEmail As New clsEmail
        '   sClsEmail.Enviar("elger@interfacenet.com.br", "Erro ao enviar dados", sTexto, "erros@interfacenet.com.br", False)
        '   EnviarEmail("", "Erro ao enviar dados", sTexto, True)
        'End If
        If Not pErroLog And parExibeMsgErro Then
            'frmErro.MostraErro(parErr, parEx, parSQL, , parOutrasMsg)
        End If
    End Sub
    Public Function MontaFiltroData(ByVal parDe As String, ByVal parAte As String, ByVal ParamArray parCampo() As String) As String
        Dim sRetorno As String = ""
        If parDe <> "" AndAlso IsDate(parDe) AndAlso parAte <> "" AndAlso IsDate(parAte) Then
            sRetorno = "CAMPO_DATA" & Plic(parDe, eTP.eD, eAP.eBET) & Plic(parAte, eTP.eD, eAP.eA)
        Else
            If parDe <> "" AndAlso IsDate(parDe) Then
                sRetorno = "CAMPO_DATA >= " & Plic(parDe, eTP.eD, eAP.eAN)
            End If
            If parAte <> "" AndAlso IsDate(parAte) Then
                If sRetorno <> "" Then sRetorno &= " AND "
                sRetorno &= "CAMPO_DATA <= " & Plic(parAte, eTP.eD, eAP.eAN)
            End If

        End If
        If sRetorno <> "" Then
            sRetorno = "(" & sRetorno & ")"
            MontaFiltroData = ""
            For Each sCampo As String In parCampo
                If MontaFiltroData <> "" Then MontaFiltroData &= " OR "
                MontaFiltroData &= Replace(sRetorno, "CAMPO_DATA", sCampo)
            Next
            If parCampo.Length > 1 Then
                MontaFiltroData = "(" & MontaFiltroData & ")"
            End If
        Else
            Return ""
        End If
    End Function
    Public Function MontaFiltroDataFormatado(ByVal parDe As String, ByVal parAte As String, ByVal ParamArray parCampo() As String) As String
        Dim sRetorno As String = ""
        If parDe <> "" AndAlso IsDate(parDe) AndAlso parAte <> "" AndAlso IsDate(parAte) Then
            sRetorno = "CAMPO_DATA" & Plic(parDe, eTP.eD_yyyymmdd, eAP.eBET) & Plic(parAte, eTP.eD_yyyymmdd, eAP.eA)
        Else
            If parDe <> "" AndAlso IsDate(parDe) Then
                sRetorno = "CAMPO_DATA >= " & Plic(parDe, eTP.eD_yyyymmdd, eAP.eAN)
            End If
            If parAte <> "" AndAlso IsDate(parAte) Then
                If sRetorno <> "" Then sRetorno &= " AND "
                sRetorno &= "CAMPO_DATA <= " & Plic(parAte, eTP.eD_yyyymmdd, eAP.eAN)
            End If

        End If
        If sRetorno <> "" Then
            sRetorno = "(" & sRetorno & ")"
            MontaFiltroDataFormatado = ""
            For Each sCampo As String In parCampo
                If MontaFiltroDataFormatado <> "" Then MontaFiltroDataFormatado &= " OR "
                MontaFiltroDataFormatado &= Replace(sRetorno, "CAMPO_DATA", sCampo)
            Next
            If parCampo.Length > 1 Then
                MontaFiltroDataFormatado = "(" & MontaFiltroDataFormatado & ")"
            End If
        Else
            Return ""
        End If
    End Function
    Public Function Alinha(ByVal fPosicao As Byte, ByVal fValor As Decimal)
        Dim fColuna As Byte
        fColuna = Len(Format(fValor, "###,###,##0.00"))
        Alinha = fPosicao - fColuna
    End Function
    Public Function ConverteValor(ByVal parValor As String) As Decimal
        If parValor <> "" Then
            If parValor.IndexOf(",") <= 0 AndAlso parValor.IndexOf(".") > 0 Then
                parValor = parValor.Replace(".", ",")
            End If
            Return CDbl(parValor)
        Else
            Return 0
        End If
    End Function
    Public Function ApagaArquivo(ByVal parArquivo As String, Optional ByVal parApagaRar As Boolean = False) As Boolean
        Dim sContaErro As Byte = 0
        On Error GoTo Trata
        If Dir(parArquivo) <> "" Then Kill(parArquivo)
        If parApagaRar Then
            Return ApagaArquivo(parArquivo & ".rar")
        Else
            Return True
        End If
Trata:
        If Err.Number = 5 And sContaErro < 200 Then
            System.Threading.Thread.Sleep(500)
            sContaErro += 1
            Resume
        End If
        GravaErro(Err, , "ApagaArquivo")
        Return False
    End Function
    Public Function VerificaPasta(ByVal parPasta As String, Optional ByVal parCria As Boolean = True) As Boolean
        Try
            If Left(Right(parPasta, 4), 1) = "." Then parPasta = parPasta.Substring(0, parPasta.LastIndexOf("\"))
            If Right(parPasta, 1) = "\" Then parPasta = parPasta.Substring(0, parPasta.Length - 1)
            If Dir(parPasta, FileAttribute.Directory) = "" Then
                If Not parCria Then
                    If MsgBox("Não foi possivel localizar a pasta: " & parPasta & vbCrLf & "Deseja criar a pasta?", MsgBoxStyle.YesNo) = MsgBoxResult.Yes Then parCria = True
                Else
                    If parPasta.Length > 4 AndAlso Left(Right(parPasta, 4), 1) = "." Then
                        parPasta = parPasta.Substring(0, parPasta.LastIndexOf("\"))
                    End If
                    MkDir(parPasta)
                End If
            End If
            Return True
        Catch ex As Exception
            GravaErro(Err, ex, , , "Pasta " & parPasta)
            Return False
        End Try
    End Function
    Public Function RetornaPos(ByVal parTexto As String, ByVal parPos As Integer, Optional ByVal parCaracter As String = "|") As String
        Dim sCont%, sPos%, sCont2%
        RetornaPos = ""
        If parTexto = "" Then Exit Function
        While sPos < parPos
            sCont = sCont + 1
            If Mid(parTexto, sCont, Len(parCaracter)) = parCaracter Then
                sCont = sCont + Len(parCaracter) - 1
                sPos = sPos + 1
            End If
            If sCont = Len(parTexto) Then Exit Function
        End While
        sCont = sCont + 1
        sCont2 = InStr(sCont + 1, parTexto, parCaracter)
        If sCont2 > 0 Then
            RetornaPos = Mid(parTexto, sCont, sCont2 - sCont)
        Else
            RetornaPos = Mid(parTexto, sCont)
        End If
    End Function
    Public Function SerialHD() As String
        Dim query = New ManagementObjectSearcher("SELECT * FROM Win32_PhysicalMedia")
        SerialHD = ""
        For Each wmiDrive As ManagementObject In query.Get()
            If Not wmiDrive("SerialNumber") Is Nothing Then
                Return wmiDrive("SerialNumber").ToString.Trim()
                Exit For
            End If
        Next
    End Function
    Public Function SerialProcessador() As String
        Dim strProcessorId As String = String.Empty
        Dim query As New SelectQuery("Win32_processor")
        Dim search As New ManagementObjectSearcher(query)
        Dim info As ManagementObject
        For Each info In search.Get()
            strProcessorId = info("processorId").ToString()
        Next
        Return strProcessorId
    End Function

    Public Function LocalizaCol(ByVal parGrid As DataGridView, ByVal parCampo As String) As Integer
        With parGrid
            For LocalizaCol = 0 To .ColumnCount - 1
                If .Columns.Item(LocalizaCol).DataPropertyName = parCampo.ToUpper Then
                    Exit Function
                End If
            Next
            LocalizaCol = -1
        End With
    End Function
    Public Function SerialHD(ByVal parPasta As String) As String
        Dim sMaxComponentLength As UInt32, sFileSystemFlags As UInt32
        Dim sRootFolder As String = IO.Path.GetPathRoot(parPasta)
        If Not sRootFolder.EndsWith("\") Then sRootFolder &= "\"
        Const MAX_PATH As Integer = &H104
        Dim sVolName As New System.Text.StringBuilder(MAX_PATH + 1)
        Dim sFName As New System.Text.StringBuilder(MAX_PATH + 1)
        Dim sSerial As UInt32
        Dim RetVal As UInt32 = GetVolumeInformation(sRootFolder, sVolName, sVolName.Capacity, _
                            sSerial, sMaxComponentLength, sFileSystemFlags, _
                            sVolName, sFName.Capacity)
        If RetVal = 0 Then Throw New System.ComponentModel.Win32Exception(Err.LastDllError)
        Dim sHPart, sLPart As Integer
        sHPart = sSerial \ 65536
        sLPart = sSerial - sHPart * 65536L
        SerialHD = Hex(sHPart).PadLeft(4, "0"c) & "-" & Hex(sLPart).PadLeft(4, "0"c)
    End Function
    'Public Function EnviarEmail(ByVal parDestinatario As String, ByVal parAssunto As String, ByVal parTexto As String, Optional ByVal parDadosLoja As Boolean = True) As Boolean
    '    Dim sMail As New MailMessage
    '    Try
    '        If parDestinatario = "" Then parDestinatario = "elger@interfacenet.com.br"
    '        If parDadosLoja Then parAssunto = "Log Sistema, Marca: " & pClsPDVINT.Marca & ", Empresa: " & pClsRede.Razao_Social & ", Loja: " & pClsFilial.Razao_Social & ", Maquina:" & Environment.MachineName
    '        Dim sSmtp As New SmtpClient("mail.interfacenet.com.br", 587)
    '        sMail.Subject = parAssunto
    '        sMail.To.Add(New MailAddress(parDestinatario))
    '        'sMail.CC.Add(New MailAddress(""))
    '        sMail.From = New MailAddress("comunica@interfacenet.com.br", "Interfacenet")
    '        sMail.IsBodyHtml = True
    '        sMail.Body = parTexto
    '        sMail.Priority = MailPriority.Normal
    '        sSmtp.Credentials = New System.Net.NetworkCredential("comunica@interfacenet.com.br", "com05net11")
    '        sSmtp.Send(sMail)
    '        Return True
    '    Catch ex As SmtpException
    '        MsgBox(ex.Message)
    '        Return False
    '    End Try
    'End Function
    Public Sub TrataEnter(ByRef parForm As Form)
        parForm.KeyPreview = True
        AddHandler parForm.KeyUp, AddressOf Formulario_KeyDown
    End Sub
    Private Sub Formulario_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs)
        If e.KeyCode = Keys.Enter AndAlso Not pNaoPula Then
            e.Handled = True
            If (e.Shift) Then
                SendKeys.Send("+{TAB}")
            Else
                SendKeys.Send("{TAB}")
            End If
        End If
        pNaoPula = False
    End Sub
    Public Function Converte_Arrey_LisOf(ByVal parArray() As String) As List(Of String)
        Dim sListOf As New List(Of String)
        For Each sObjeto As String In parArray
            sListOf.Add(sObjeto)
        Next
        Return sListOf
    End Function
    Public Function Recebe(ByVal parDyna As ADODB.Recordset, ByVal parCampo As String, Optional ByVal parTamanho As Integer = 0, Optional ByVal parNumero As Boolean = False) As String
        Dim sTexto As String
        If IsDBNull(parDyna.Fields(parCampo).Value) Then
            If parNumero Then
                sTexto = 0
            Else
                sTexto = ""
            End If
        Else
            sTexto = parDyna.Fields(parCampo).Value.ToString.Trim
        End If
        If parTamanho > 0 AndAlso Len(sTexto) > parTamanho Then sTexto = sTexto.Substring(0, parTamanho)
        Return sTexto
    End Function
    Public Function CriaAssinatura(ByVal ParTexto As String) As Long
        Dim sCont As Integer, sResultado As Long
        For sCont = 1 To Len(ParTexto)
            sResultado = sResultado + ((Asc(Mid(ParTexto, sCont, 1))) * sCont)
        Next sCont
        If Dir("C:\PDV\ECF\ASSINATURA.TXT") <> "" Then
            IO.File.AppendAllText("C:\PDV\ECF\ASSINATURA.TXT", "|" & Now & "|" & "CriaAssinatura" & "|" & "OUTRO" & ParTexto & "|" & sResultado)
        End If
        CriaAssinatura = sResultado
    End Function

    Public Function DadosHD(ByVal parPasta As String, ByRef parSerial As String) As Boolean
        Dim sMaxComponentLength As UInt32, sFileSystemFlags As UInt32
        Dim sRootFolder As String = IO.Path.GetPathRoot(parPasta)
        If Not sRootFolder.EndsWith("\") Then sRootFolder &= "\"
        Const MAX_PATH As Integer = &H104
        Dim sVolName As New System.Text.StringBuilder(MAX_PATH + 1)
        Dim sFName As New System.Text.StringBuilder(MAX_PATH + 1)
        Dim sSerial As UInt32
        Dim RetVal As UInt32 = GetVolumeInformation(sRootFolder, sVolName, sVolName.Capacity, _
                            sSerial, sMaxComponentLength, sFileSystemFlags, _
                            sVolName, sFName.Capacity)
        If RetVal = 0 Then Throw New System.ComponentModel.Win32Exception(Err.LastDllError)
        Dim sHPart, sLPart As Integer
        sHPart = sSerial \ 65536
        sLPart = sSerial - sHPart * 65536L
        parSerial = Hex(sHPart).PadLeft(4, "0"c) & "-" & Hex(sLPart).PadLeft(4, "0"c)
        Return True
    End Function
    Public Function GetTemperatura(ByVal Format As TempFormat) As Single
        If fErroTemperatura Then
            Return 0
        End If
        Try
            Dim enumerator As System.Management.ManagementObjectCollection.ManagementObjectEnumerator
            Dim searcher As New System.Management.ManagementObjectSearcher("root\WMI", "SELECT * FROM MSAcpi_ThermalZoneTemperature")
            enumerator = searcher.Get.GetEnumerator()
            While enumerator.MoveNext
                Dim obj As System.Management.ManagementObject = CType(enumerator.Current, System.Management.ManagementObject)
                Select Case Format
                    Case TempFormat.Fahrenheit
                        Return CSng((obj.Item("CurrentTemperature") / 10 - 273.14999999999998) * 9 / 5 + 32)
                    Case TempFormat.Celsius
                        Return CSng(obj.Item("CurrentTemperature") / 10 - 273.14999999999998)
                    Case TempFormat.Kelvin
                        Return CSng(obj.Item("CurrentTemperature") / 10)
                    Case TempFormat.Raw
                        Return CSng(obj.Item("CurrentTemperature"))
                    Case Else
                        Return 0
                End Select
            End While
            Return 0
        Catch ex As Exception
            fErroTemperatura = True
            'GravaErro(Err, ex, "Temperatura", True)
            Return 0
        End Try
    End Function
    Public Function ConsultaData(ByRef parSQL As String, ByVal parCampo As String, ByVal parDate As Object, ByVal parDe As Object, Optional ByVal parObrigatorio As Boolean = True, Optional ByVal parHora As Boolean = True) As Boolean
        Dim sDe As String, sAte As String
        If TypeOf parDate Is TextBox Then
            sDe = parDate.Text
        ElseIf TypeOf parDate Is DevExpress.XtraBars.BarEditItem Then
            If parDate.EditValue Is Nothing Then
                sDe = ""
            Else
                sDe = parDate.EditValue
            End If
        Else
            sDe = parDate
        End If
        If TypeOf parDe Is TextBox Then
            sAte = parDe.Text
        ElseIf TypeOf parDe Is DevExpress.XtraBars.BarEditItem Then
            If parDe.EditValue Is Nothing Then
                sAte = ""
            Else
                sAte = parDe.EditValue
            End If
        Else
            sAte = parDe
        End If
        If IsDate(sDe) Then
            If IsDate(sAte) Then
                If DateDiff(DateInterval.Day, CDate(sDe), CDate(sAte)) < 0 Then
                    If parObrigatorio Then MsgBox("Período inválido de datas!", MsgBoxStyle.Information)
                    Return False
                End If
                If parHora Then
                    parSQL = parSQL & " AND (" & parCampo & Plic(sDe & " 00:00:00", eTP.eDH, eAP.eBET) & Plic(sAte & " 23:59:59", eTP.eDH, eAP.eA) & ")"
                Else
                    parSQL = parSQL & " AND (" & parCampo & Plic(sDe, eTP.eD, eAP.eBET) & Plic(sAte, eTP.eD, eAP.eA) & ")"
                End If
            Else
                parSQL = parSQL & " AND (" & parCampo & " >= " & Plic(sDe, eTP.eD) & ")"
            End If
        Else
            If parObrigatorio Then MsgBox("Filtro data obrigatório!", MsgBoxStyle.Information)
            Return False
        End If
        Return True
    End Function

    Public Function Plic(ByVal parObject As Object, ByVal parTipo As eTP, Optional ByVal parAntes As eAP = eAP.eAN, Optional ByVal parDepois As eDP = eDP.eDN) As String
        Dim sTexto As String = "", sRetorno As String = ""
        If TypeOf parObject Is TextBox Then
            sTexto = parObject.Text
        ElseIf TypeOf parObject Is DevExpress.XtraBars.BarEditItem Then
            If parObject.EditValue Is Nothing Then
                sTexto = ""
            Else
                sTexto = parObject.EditValue
            End If
        Else
            sTexto = parObject
        End If
        Select Case parAntes
            Case eAP.eA
                sRetorno = " AND "
            Case eAP.eO
                sRetorno = " OR "
            Case eAP.eW
                sRetorno = " WERE "
            Case eAP.eBET
                sRetorno = " BETWEEN "
        End Select
        Select Case parTipo
            Case eTP.eD
                If IsDate(sTexto) Then
                    If pClsPDVINT.TipoBanco = clsPDVINT.enuTipoBanco.Access Then
                        sRetorno = "#" + Format(CDate(sTexto), "MM/dd/yyyy") + "#"
                    Else
                        sRetorno = sRetorno & "'" & CType(sTexto, Date).Date & "'"
                    End If

                Else
                    sRetorno = sRetorno & "NULL"
                End If
            Case eTP.eD_yyyymmdd
                If IsDate(sTexto) Then
                    sRetorno = sRetorno & "'" & Format(CType(sTexto, Date).Date, "yyyy-MM-dd") & "'"
                Else
                    sRetorno = sRetorno & "NULL"
                End If

            Case eTP.eDH
                If IsDate(sTexto) Then
                    If pClsPDVINT.TipoBanco = clsPDVINT.enuTipoBanco.Access Then
                        sRetorno = "#" + Format(CDate(sTexto), "MM/dd/yyyy HH:mm:ss") + "#"
                    Else
                        sRetorno = sRetorno & "'" & CType(sTexto, Date).Date & " " & CType(sTexto, Date).Hour & ":" & CType(sTexto, Date).Minute & ":" & CType(sTexto, Date).Second & "'"
                    End If
                Else
                    sRetorno = sRetorno & "NULL"
                End If
            Case eTP.eDHMYSQL
                If IsDate(sTexto) Then
                    sRetorno = sRetorno & "'" & CType(sTexto, Date).Year & "/" & CType(sTexto, Date).Month & "/" & CType(sTexto, Date).Day & " " & CType(sTexto, Date).Hour & ":" & CType(sTexto, Date).Minute & ":" & CType(sTexto, Date).Second & "'"
                Else
                    sRetorno = sRetorno & "NULL"
                End If
            Case eTP.eH
                If IsDate(sTexto) Then
                    sRetorno = sRetorno & "'" & CType(sTexto, Date).Hour & "'"
                Else
                    sRetorno = sRetorno & "NULL"
                End If
            Case eTP.eN
                sRetorno = sRetorno & sTexto.Replace(",", ".")
            Case eTP.eT
                If sTexto Is Nothing Then sTexto = ""
                sRetorno = sRetorno & "'" & sTexto.Replace("'", "' + '''' + '") & "'"
            Case eTP.eLike
                sRetorno = sRetorno & "LIKE '%" & sTexto & "%'"
            Case eTP.eLikeI
                sRetorno = sRetorno & "LIKE '%" & sTexto & "'"
            Case eTP.eLikeF
                sRetorno = sRetorno & "LIKE '" & sTexto & "%'"
            Case eTP.eAspaDup
                sRetorno = sRetorno & Chr(34) & sTexto & Chr(34)
        End Select
        Select Case parDepois
            Case eDP.eF
                sRetorno = sRetorno & ") "
            Case eDP.eV
                sRetorno = sRetorno & ", "
        End Select
        Return sRetorno
    End Function
    Public Function ValidaData(ByVal parDe As DateTimePicker, ByVal parAte As DateTimePicker) As Boolean
        If parDe.Text = "" OrElse Not IsDate(parDe.Text) Then
            MsgBox("Digite uma data para pesquisa", MsgBoxStyle.Information)
            parDe.Focus()
            Return False
        End If
        If parAte.Text = "" OrElse Not IsDate(parAte.Text) Then
            MsgBox("Digite uma data para pesquisa", MsgBoxStyle.Information)
            parAte.Focus()
            Return False
        End If
        If CDate(parDe.Text) > CDate(parAte.Text) Then
            MsgBox("Intervalo de data inválido", MsgBoxStyle.Information)
            parDe.Focus()
            Return False
        End If
        Return True
    End Function

    Public Function ValidaDia(ByVal fDia As Date, Optional ByRef fFeriado As Boolean = False) As Date
        Dim fAno As Integer, A As Integer, B As Integer, C As Integer, d As Integer, E As Integer, F As Integer, G As Integer, H As Integer, i As Integer, k As Integer, L As Integer, M As Integer, p As Integer, q As Integer, fPascoa As Date, fCarnaval As Date, fSanta As Date, fCorpus As Date
        If Weekday(fDia) = 1 Then
            fDia = fDia.AddDays(1)
        ElseIf Weekday(fDia) = 7 Then
            fDia = fDia.AddDays(2)
        End If
        fAno = Year(fDia)
        If fDia.Day = 1 And Month(fDia) = 1 Then
            fDia = fDia.AddDays(1)
        ElseIf fDia.Day = 21 And Month(fDia) = 4 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        ElseIf fDia.Day = 1 And Month(fDia) = 5 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        ElseIf fDia.Day = 7 And Month(fDia) = 9 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        ElseIf fDia.Day = 12 And Month(fDia) = 10 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        ElseIf fDia.Day = 2 And Month(fDia) = 11 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        ElseIf fDia.Day = 15 And Month(fDia) = 11 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        ElseIf fDia.Day = 25 And Month(fDia) = 12 Then
            fDia = fDia.AddDays(1)
            fFeriado = True
        End If
        A = (fAno Mod 19)
        B = Int(fAno / 100)
        C = (fAno Mod 100)
        d = Int(B / 4)
        E = (B Mod 4)
        F = Int((B + 8) / 25)
        G = Int((B - F + 1) / 3)
        H = ((19 * A + B - d - G + 15) Mod 30)
        i = Int(C / 4)
        k = (C Mod 4)
        L = ((32 + 2 * E + 2 * i - H - k) Mod 7)
        M = Int((A + 11 * H + 22 * L) / 451)
        p = Int((H + L - 7 * M + 114) / 31)
        q = ((H + L - 7 * M + 114) Mod 31)
        fPascoa = CDate((q + 1) & "/" & p & "/" & fAno)
        fCarnaval = DateAdd("d", -47, fPascoa)
        fSanta = DateAdd("d", -2, fPascoa)
        fCorpus = DateAdd("d", 60, fPascoa)
        If fDia = fSanta Or fDia = fCarnaval Or fDia = fCorpus Then
            fFeriado = True
        End If
        If Weekday(fDia) = 1 Then
            fDia = fDia.AddDays(1)
        ElseIf Weekday(fDia) = 7 Then
            fDia = fDia.AddDays(2)
        End If
        If fDia = fCarnaval Or fDia = fPascoa Or fDia = fSanta Or fDia = fCorpus Then
            fDia = fDia.AddDays(1)
        End If
        If Weekday(fDia) = 1 Then
            fDia = fDia.AddDays(1)
        ElseIf Weekday(fDia) = 7 Then
            fDia = fDia.AddDays(2)
        End If
        ValidaDia = fDia
    End Function

    Public Function SemAcento(ByVal QTexto As String, Optional ByVal ParExtras As Byte = 0) As String
        Dim Y As Integer, vString1 As String, vString2 As String, vPosicao As Integer
        vString1 = "áéíóúâêîôûàèìòùäëïöüÁÉÍÓÚÂÊÎÔÛÀÈÌÒÙÄËÏÖÜãõÃÕçÇñÑº|'"
        If ParExtras = 1 Then
            vString1 = vString1 + "\/:*?<>"
        End If
        vString2 = "aeiouaeiouaeiouaeiouAEIOUAEIOUAEIOUAEIOUaoAOcCnN   "
        If ParExtras = 1 Then
            vString2 = vString2 + "        "
        End If
        For Y = 1 To Len(vString1)
            vPosicao = InStr(1, QTexto, Mid(vString1, Y, 1), vbBinaryCompare)
            If vPosicao <> 0 Then
                Mid(QTexto, vPosicao, 1) = Mid(vString2, Y, 1)
                Y = Y - 1
            End If
        Next Y
        SemAcento = QTexto
    End Function
    Public Function DeCrip(ByVal X As String) As String
        Dim temp As String = "", Code As Integer, n As Integer
        Dim Cript(6) As Integer
        Cript(1) = 27
        Cript(2) = 132
        Cript(3) = 89
        Cript(4) = 215
        Cript(5) = 171
        Cript(6) = 171
        X = Trim(X)
        For n = 1 To Len(X)
            Code = Asc(Mid$(X, n, 1)) - Cript(n)
            If Code < 0 Then Code = Code + 255
            temp = temp + Chr(Code)
        Next n
        DeCrip = temp
    End Function
    Public Function Crip(ByVal X As String) As String
        Dim temp As String = "", Code As Integer, n As Integer
        Dim Cript(6) As Integer
        Cript(1) = 27
        Cript(2) = 132
        Cript(3) = 89
        Cript(4) = 215
        Cript(5) = 171
        Cript(6) = 171
        X = Trim(X)
        For n = 1 To Len(X)
            Code = Asc(Mid$(X, n, 1)) + Cript(n)
            If Code > 255 Then Code = Code - 255
            temp = temp + Chr(Code)
        Next n
        Crip = temp
    End Function
    Public Function listaBanco(ByRef sCombo As ComboBox, ByVal sServidor$, ByVal sUsuario$, ByVal sSenha$) As Boolean
        On Error GoTo Trata
        Dim sSql As String, sDyna As New ADODB.Recordset
        Dim sBanco As New ADODB.Connection
        With sBanco
            .ConnectionTimeout = 1
            .Provider = "SQLOLEDB"
            .Properties("Data Source").Value = sServidor
            .Properties("Persist Security Info").Value = True
            .Properties("Initial Catalog").Value = "MASTER"
            .Properties("User Id").Value = sUsuario
            .Properties("Password").Value = sSenha
            .Open()
            .CursorLocation = ADODB.CursorLocationEnum.adUseClient
            .CommandTimeout = 200
        End With
        sSql = "SELECT NAME FROM SYSDATABASES WHERE DBID > 4 ORDER BY NAME"
        With sDyna
            .Open(sSql, sBanco, ADODB.CursorTypeEnum.adOpenForwardOnly, ADODB.LockTypeEnum.adLockReadOnly)
            sCombo.Items.Clear()
            If Not .EOF Then
                While Not .EOF
                    sCombo.Items.Add(.Fields(0).Value)
                    .MoveNext()
                End While
            End If
        End With
        sDyna.Close()
        sDyna = Nothing
        sBanco = Nothing
        Return True
        Exit Function
Trata:
        Return False
        MsgBox(Err.Description, vbCritical, "ListaBanco")
    End Function
    Public Sub Titulo(ByVal parMultRede As Boolean, ByVal parNome As String, ByVal parForm As Form)
        parForm.Text = Application.ProductName & " - V." & Application.ProductVersion & IIf(parMultRede, " - " & parNome, "")
    End Sub
    Public Function ConsultaRegistroStartup(Optional ByVal parComando As String = "", Optional ByVal parMsgErr As Boolean = True, Optional ByVal parIncluir As Boolean = False) As Boolean
        'Iniciar com o Windows
        Dim sRegKey As Microsoft.Win32.RegistryKey
        Try
            sRegKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
            If sRegKey.GetValue(Application.ProductName) <> "" Then
                If sRegKey.GetValue(Application.ProductName) <> Application.ExecutablePath & (" " & parComando).ToString.TrimEnd Then
                    If excluirRegistroStartup() Then
                        sRegKey.Close()
                        Return incluirRegistroStartup(parComando)
                    End If
                End If
            Else
                If parIncluir Then incluirRegistroStartup(parComando)
                sRegKey.Close()
                Return True
            End If
            sRegKey.Close()
            Return False
        Catch ex As Exception
            If parMsgErr Then MsgBox("Não foi possivel consultar o registro do sistema no Windows. Você não está logado com um usuário que possua permissão para alterar o registro. Faça login com um usuário que tenha permissão e ou desmarque essa opção tente novamente. Essa configuração não será alterada.", MsgBoxStyle.Critical)
            Return False
        End Try
    End Function
    Public Function incluirRegistroStartup(Optional ByVal parComando As String = "") As Boolean
        'Iniciar com o Windows
        Dim sRegKey As Microsoft.Win32.RegistryKey
        Try
            sRegKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
            sRegKey.SetValue(Application.ProductName, Application.ExecutablePath & (" " & parComando).ToString.TrimEnd)
            sRegKey.Close()
            Return True
        Catch ex As Exception
            MsgBox("Não foi possivel incluir o registro do sistema no Windows. Você não está logado com um usuário que possua permissão para alterar o registro. Faça login com um usuário que tenha permissão e ou desmarque essa opção tente novamente. Essa configuração não será alterada.", MsgBoxStyle.Critical)
            Return False
        End Try
    End Function
    Public Function VerificaVersaoNetFramework(ByVal parVersao As String) As Boolean
        Dim sRegKey As Microsoft.Win32.RegistryKey
        Try
            sRegKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\" & parVersao, True)
            If sRegKey.GetValue("Install") = 1 Then
                sRegKey.Close()
                Return True
            Else
                sRegKey.Close()
                Return False
            End If
        Catch ex As Exception
            MsgBox("Não foi possível encontrar a versão " & parVersao & " do .NET FrameWork em seu computador. O sistema precisa dos componentes do .NET FrameWork para ser executado." & vbCrLf & "A versão 3.5 SP1 do .NET FrameWork pode ser baixada através do link abaixo:" & vbCrLf & "http://www.microsoft.com/downloads/details.aspx?familyid=ab99342f-5d1a-413d-8319-81da479ab0d7&displaylang=pt-br", MsgBoxStyle.Critical)
            Return False
        End Try
    End Function
    Public Function excluirRegistroStartup() As Boolean
        'Deletar Registro do Windows
        Dim sRegKey As Microsoft.Win32.RegistryKey
        Try
            sRegKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True)
            sRegKey.DeleteValue(Application.ProductName, False)
            sRegKey.Close()
            Return True
        Catch ex As Exception
            MsgBox("Não foi possivel remover o registro do sistema no Windows. Você não está logado com um usuário que possua permissão para alterar o registro. Faça login com um usuário que tenha permissão e ou desmarque essa opção tente novamente. Essa configuração não será alterada.", MsgBoxStyle.Critical)
            Return False
        End Try
    End Function

    Public Class ComboItemData
        Private fValor As Object
        Private fDescricao As String


        Public Property Valor() As Object
            Get
                Return fValor
            End Get
            Set(ByVal value As Object)
                fValor = value
            End Set
        End Property

        Public Property Descricao() As String
            Get
                Return fDescricao
            End Get
            Set(ByVal value As String)
                fDescricao = value
            End Set
        End Property
        Public Sub New(ByVal parValor As Object, ByVal parDescricao As String)
            Valor = parValor
            Descricao = parDescricao
        End Sub
        Public Overrides Function ToString() As String
            Return Descricao
        End Function
    End Class

    Public Function PreparaCombo(ByRef parCombo As ComboBox, ByVal parPesquisa As String, Optional ByVal parAddItemVazio As Boolean = False) As Boolean
        If Trim(parPesquisa) = "" Then Return False
        Dim sConexao As New clsConexao
        Dim sDyna As New ADODB.Recordset
        parCombo.Items.Clear()
        If sConexao.Conecta() Then
            If sConexao.AbreConexao(sDyna, parPesquisa, clsConexao.enuTConexao.Consulta) Then
                If parAddItemVazio Then
                    parCombo.Items.Add(New ComboItemData("", ""))
                End If
                While Not sDyna.EOF
                    If sDyna.Fields.Count = 2 Then
                        Dim sCodigo As String = Trim(sDyna.Fields(0).Value)
                        Dim sDescricao As String = Trim(sDyna.Fields(1).Value)
                        parCombo.Items.Add(New ComboItemData(sCodigo, sDescricao))
                        sDyna.MoveNext()
                    ElseIf parCombo.Items.Add(New ComboItemData(Trim(sDyna.Fields(0).Value), Trim(sDyna.Fields(1).Value))) Then
                        parCombo.Items.Add(New ComboItemData(sDyna.Fields(0).Value, sDyna.Fields(0).Value))
                        sDyna.MoveNext()
                    Else
                        Return False
                    End If
                End While
            Else
                sConexao.Libera(sDyna)
                sDyna = Nothing
                sConexao = Nothing
                Return False
            End If
        Else
            sConexao.Libera(sDyna)
            sDyna = Nothing
            sConexao = Nothing
            Return False
        End If
        sConexao.Libera(sDyna)
        sDyna = Nothing
        sConexao = Nothing
        Return True
    End Function

    Public Sub InformaTempoGasto(ByVal parTempoInicial As DateTime)
        Try
            Dim sTempoFinal = Now
            Dim sTempoTotal As TimeSpan
            sTempoTotal = sTempoFinal.Subtract(parTempoInicial)
            MsgBox("Operação concluída com sucesso!" & vbCrLf & "Tempo total gasto: " & sTempoTotal.Days & " dia(s), " & sTempoTotal.Hours & " hora(s), " & sTempoTotal.Minutes & " minuto(s), " & sTempoTotal.Seconds & " segundo(s).", MsgBoxStyle.Information, "Tempo total da exportação")
        Catch ex As Exception
            Exit Sub
        End Try
    End Sub

End Module
